home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / bipl.zip / PROCS.ZIP / PRINTF.ICN < prev    next >
Text File  |  1992-09-28  |  4KB  |  173 lines
  1. ############################################################################
  2. #
  3. #    File:     printf.icn
  4. #
  5. #    Subject:  Procedures for printf-style formatting
  6. #
  7. #    Author:   William H. Mitchell, modified by Cheyenne Wills and
  8. #          Phillip Lee Thomas
  9. #
  10. #    Date:     September 2, 1992
  11. #
  12. ###########################################################################
  13. #
  14. #     This procedure behaves somewhat like the standard printf.
  15. #  Supports d, s, o, and x formats like printf.  An "r" format
  16. #  prints real numbers in a manner similar to that of printf's "f",
  17. #  but will produce a result in an exponential format if the number
  18. #  is larger than the largest integer plus one.
  19. #
  20. #     Left or right justification and field width control are pro-
  21. #  vided as in printf.   %s and %r handle precision specifications.
  22. #
  23. #     The %r format is quite a bit of a hack, but it meets the
  24. #  author's requirements for accuracy and speed.  Code contributions
  25. #  for %f, %e, and %g formats that work like printf are welcome.
  26. #
  27. #     Possible new formats:
  28. #
  29. #       %t -- print a real number as a time in hh:mm
  30. #       %R -- roman numerals
  31. #       %w -- integers in english
  32. #       %b -- binary
  33. #
  34. ############################################################################
  35.  
  36. procedure sprintf(format, args[])
  37.     return _doprnt(format, args)
  38. end
  39.  
  40. procedure fprintf(file, format, args[])
  41.     writes(file, _doprnt(format, args))
  42.     return
  43. end
  44.  
  45. procedure printf(format, args[])
  46.     writes(&output, _doprnt(format, args))
  47.     return
  48. end
  49.  
  50. procedure _doprnt(format, args)
  51.    local out, v, just, width, conv, prec, pad
  52.  
  53.     out := ""
  54.     format ? repeat {
  55.         (out ||:= tab(upto('%'))) | (out ||:= tab(0) & break)
  56.         v := get(args)
  57.         move(1)
  58.         just := right
  59.         width := conv := prec := pad := &null
  60.         ="-" & just := left
  61.         width := tab(many(&digits))
  62.         (\width)[1] == "0" & pad := "0"
  63.         ="." & prec := tab(many(&digits))
  64.         conv := move(1)
  65.  
  66.         ##write("just: ",image(just),", width: ", width, ", prec: ",
  67.         ## prec, ", conv: ", conv)
  68.         case conv of {
  69.             "d": {
  70.             v := string(integer(v))
  71.             }
  72.             "s": {
  73.             v := string(v[1:(\prec+1)|0])
  74.             }
  75.             "x": v := hexstr(v)
  76.             "o": v := octstr(v)
  77.             "i": v := image(v)
  78.             "r": v := fixnum(v,prec)
  79.             default: {
  80.             push(args, v)
  81.             v := conv
  82.             }
  83.             }
  84.         if \width & *v < width then {
  85.             v := just(v, width, pad)
  86.             }
  87.         out ||:= v
  88.         }
  89.  
  90.     return out
  91. end
  92.  
  93. procedure hexstr(n)
  94.    local h, neg
  95.    static BigNeg, hexdigs, hexfix
  96.  
  97.     initial {
  98.         BigNeg := -2147483647-1
  99.         hexdigs := "0123456789abcdef"
  100.         hexfix := "89abcdef"
  101.         }
  102.  
  103.     n := integer(n)
  104.     if n = BigNeg then
  105.         return "80000000"
  106.     h := ""
  107.     if n < 0 then {
  108.         n := -(BigNeg - n)
  109.         neg := 1
  110.         }
  111.     repeat {
  112.         h := hexdigs[n%16+1]||h
  113.         if (n /:= 16) = 0 then
  114.             break
  115.         }
  116.     if \neg then {
  117.         h := right(h,8,"0")
  118.         h[1] := hexfix[h[1]+1]
  119.         }
  120.     return h
  121. end
  122. procedure octstr(n)
  123.    local h, neg
  124.    static BigNeg, octdigs, octfix
  125.  
  126.     initial {
  127.         BigNeg := -2147483647-1
  128.         octdigs := "01234567"
  129.         octfix := "23"
  130.         }
  131.  
  132.     n := integer(n)
  133.     if n = BigNeg then
  134.         return "20000000000"
  135.     h := ""
  136.     if n < 0 then {
  137.         n := -(BigNeg - n)
  138.         neg := 1
  139.         }
  140.     repeat {
  141.         h := octdigs[n%8+1]||h
  142.         if (n /:= 8) = 0 then
  143.             break
  144.         }
  145.     if \neg then {
  146.         h := right(h,11,"0")
  147.         h[1] := octfix[h[1]+1]
  148.         }
  149.     return h
  150. end
  151.  
  152. procedure fixnum(x, prec)
  153.    local int, frac, f1, f2, p10
  154.  
  155.     /prec := 6
  156.     int := integer(x) | return image(x)
  157.     frac := image(x - int)
  158.     if find("e", frac) then {
  159.         frac ?:= {
  160.             f1 := tab(upto('.')) &
  161.             move(1) &
  162.             f2 := tab(upto('e')) &
  163.             move(1) &
  164.             p10 := -integer(tab(0)) &
  165.             repl("0",p10-1) || f1 || f2
  166.             }
  167.         }
  168.     else
  169.         frac ?:= (tab(upto('.')) & move(1) & tab(0))
  170.     frac := left(frac, prec, "0")
  171.     return int || "." || frac
  172. end
  173.